home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / HAM_RAD / PROPAGAT / 3068.ZIP / MAPPER.ZIP / MAP-SUBS.BAS < prev    next >
BASIC Source File  |  1991-08-10  |  23KB  |  506 lines
  1. 100 DEFINT I-N
  2. 110 '$INCLUDE:'MAP-COM.INC'
  3. 200 '$INCLUDE:'MAP-DEF.INC'
  4. 10000 SUB PROPAGATE (METHOD,TLAT, TLON, RLAT, RLON, LPATH%, MONTH, DAY, TIME, SSN, NHOPS, EXTRA.HOPS%, F.MUF, F.LUF, E.CUTOFF,GMT) STATIC
  5. 10010 WIDTH LPRINT 128
  6. 10020 DIM M$(37), A$(4), M(12)
  7. 10030 X$ = STRING$(79, 61)
  8. 10040 HEIGHT.F2 = 275+SSN/2: HEIGHT.E = 110: HEIGHT.D = 90
  9. 10050 POL.LAT = 78.3 / CNV: POL.LON = 69 / CNV
  10. 10060 GMT = TIME - TLON / 15: GMT = FNT.MOD(GMT, 24)
  11. 10070 T.LAT = TLAT * RPD: T.LON = -TLON * RPD: R.LAT = RLAT * RPD: R.LON = -RLON * RPD:
  12. 10080 PHI = CNV * FNASIN(RE * COS(E.MIN / CNV) / (RE + HEIGHT.F2))
  13. 10090 TH = 180 - PHI - 90 - E.MIN
  14. 10100 GR.MAX = 2 * TH * RE / CNV
  15. 10110 GOSUB 12000: REM   TO MAIN CALCULATION LOOP
  16. 10120 EXIT SUB
  17. 12000 REM   MINIMUF 4.1 CALCULATION LOOP
  18. 12010 COS.GRNG = SIN(T.LAT) * SIN(R.LAT) + COS(T.LAT) * COS(R.LAT) * COS(R.LON - T.LON)
  19. 12020 GRNG = FNACOS(COS.GRNG): IF LPATH% THEN GRNG = 2 * PI - GRNG
  20. 12030 MIN.NHOPS = 1 + FIX(RE * GRNG / GR.MAX)'NUMBER OF 3500 KM HOPS
  21. 12040 NHOPS = MIN.NHOPS + EXTRA.HOPS%
  22. 12050 HOP.INV = 1! / NHOPS
  23. 12060 F.MUF = 100: E.CUTOFF = 0: F.LUF = 0
  24. 12070 ANG = .5 * GRNG / CSNG(NHOPS): R.SLANT = SQR(RE ^ 2 + (RE + HEIGHT.F2) ^ 2 - 2 * RE * (RE + HEIGHT.F2) * COS(ANG))
  25. 12080 ELEV = CNV * FNACOS((RE + HEIGHT.F2) * SIN(ANG) / R.SLANT)
  26. 12090 PHID = CNV * FNASIN(RE * COS(ELEV / CNV) / (RE + HEIGHT.D))' INCIDENCE ANGLE ON D LAYER AT 90 KM
  27. 12100 PATH.LOSS = 2 * FNDB(4 * PI * R.SLANT * 2 * NHOPS * 1000)
  28. 12110 ANG = GRNG / (1 + NHOPS): EL.MAX = ATN(1 / TAN(ANG) - (RE / (RE + HEIGHT.F2)) / SIN(ANG)): IF EL.MAX < 18 / CNV THEN EL.MAX = 18 / CNV
  29. 12120 SEC.EINC = 1 / SQR(1 - ((RE / (RE + HEIGHT.E)) * COS(EL.MAX)) ^ 2)
  30. 12130 FOR I = 1 TO NFREQ
  31. 12140 CALL MULTIPATH(ELEV, WAVE.LEN(I), H.TXANT(I), XMULTV, XMULTH): IF TX.POL%(I) THEN TX.LOSS(I) = XMULTV ELSE TX.LOSS(I) = XMULTH
  32. 12150 CALL MULTIPATH(ELEV, WAVE.LEN(I), H.RXANT(I), XMULTV, XMULTH): IF RX.POL%(I) THEN RX.LOSS(I) = XMULTV ELSE RX.LOSS(I) = XMULTH
  33. 12160 REF.LOSS(I) = 0: ABSORB.LOSS(I) = 0: NEXT I
  34. 13000 FOR KHOP = 1 TO NHOPS
  35. 13010 PATH.FRAC = (KHOP - .5) / NHOPS:
  36. 13020 REFL.PATH.FRAC = CSNG(KHOP - 1!) / NHOPS
  37. 13030 IF METHOD>0 THEN
  38. 13040    CTRL.POINTS%=-1
  39. 13050 ELSE
  40. 13060    IF KHOP=1 OR KHOP=NHOPS THEN
  41. 13070       CTRL.POINTS%=-1
  42. 13080    ELSE
  43. 13090       CTRL.POINTS%=0
  44. 13100    END IF
  45. 13110 END IF
  46. 13120 SIN.RLAT = SIN(R.LAT)
  47. 13130 COS.RLAT = COS(R.LAT)
  48. 13140 COS.RAZIM = (SIN(T.LAT) - SIN.RLAT * COS(GRNG)) / (COS.RLAT * SIN(GRNG))
  49. 13150 CTRL.RNG = GRNG * PATH.FRAC: REFL.RNG = GRNG * REFL.PATH.FRAC
  50. 13160 SIN.CLAT = SIN.RLAT * COS(CTRL.RNG) + COS.RLAT * SIN(CTRL.RNG) * COS.RAZIM
  51. 13170 SIN.RFLAT = SIN.RLAT * COS(REFL.RNG) + COS.RLAT * SIN(REFL.RNG) * COS.RAZIM
  52. 13180 COS.CLON = (COS(CTRL.RNG) - SIN.CLAT * SIN.RLAT) / (COS.RLAT * SQR(1 - SIN.CLAT ^ 2))
  53. 13190 COS.RFLON = (COS(REFL.RNG) - SIN.RFLAT * SIN.RLAT) / (COS.RLAT * SQR(1 - SIN.RFLAT ^ 2))
  54. 13200 CLON = FNACOS(COS.CLON): RFLON = FNACOS(COS.RFLON)
  55. 13210 C.LON = R.LON + SGN(SIN(T.LON - R.LON)) * CLON
  56. 13220 IF C.LON < 0 THEN C.LON = C.LON + PI2
  57. 13230 IF C.LON >= PI2 THEN C.LON = C.LON - PI2
  58. 13240 C.LAT = PI.D2 - FNACOS(SIN.CLAT)
  59. 13250 RF.LON = R.LON + SGN(SIN(T.LON - R.LON)) * RFLON
  60. 13260 IF RF.LON < 0 THEN RF.LON = RF.LON + PI2
  61. 13270 IF RF.LON >= PI2 THEN RF.LON = RF.LON - PI2
  62. 13280 RF.LAT = (PI.D2 - FNACOS(SIN.RFLAT)) * CNV
  63. 13290 RFL = CNV * RF.LON
  64. 13300 RF.LON = FNXFORM(-CNV * RF.LON,TLON)
  65. 13310 IF REFL.PATH.FRAC = 0 THEN GOTO 14020
  66. 13320 'IF POINT(RF.LON, RF.LAT) = 1 THEN SEA% = -1 ELSE SEA% = 0
  67. 13330 CALL FIND.OCEAN(RFL,RF.LAT,SEA%)
  68. 14000 FOR I = 1 TO NFREQ: CALL REFLECT(ELEV, WAVE.LEN(I), SEA%, RMV, VP, RMH, HP, REFLECT.LOSS)
  69. 14010 REF.LOSS(I) = REF.LOSS(I) + REFLECT.LOSS: NEXT I
  70. 14020 YR.ANGLE = .0172 * (10 + (MONTH - 1) * 30.4 + DAY)
  71. 14030 TILT.ANGLE = .409 * COS(YR.ANGLE): COSX1 = -1: COSX2 = -1: COSX3 = -1
  72. 14040 T.NOON = 3.82 * C.LON + 12 + .13 * (SIN(YR.ANGLE) + 1.2 * SIN(2 * YR.ANGLE))
  73. 14050 T.NOON = FNT.MOD(T.NOON, 24)
  74. 14060 IF COS(C.LAT + TILT.ANGLE) > -.26 THEN GOTO SUN.LIGHT
  75. 14070 T.SUN = 0
  76. 14080 COSX = 0
  77. 14090 M.FACT! = 2.5 * GRNG * HOP.INV
  78. 14100 IF M.FACT! > PI.D2 THEN M.FACT! = PI.D2
  79. 14110 M.FACT! = SIN(M.FACT!)
  80. 14120 M.FACT! = 1 + 2.5 * M.FACT! * SQR(M.FACT!)
  81. 14130 GOTO MUF.CALC
  82. 15000 SUN.LIGHT:
  83. 15010 T.SUN = (-.26 + SIN(TILT.ANGLE) * SIN(C.LAT)) / (COS(TILT.ANGLE) * COS(C.LAT) + 9.999999E-04)
  84. 15020 T.SUN = 12 - ATN(T.SUN / SQR(ABS(1 - T.SUN * T.SUN))) * 7.639437
  85. 15030 T.RISE = T.NOON - T.SUN / 2 + 12 * (1 - SGN(T.NOON - T.SUN / 2)) * SGN(ABS(T.NOON - T.SUN / 2))
  86. 15040 T.SET = T.NOON + T.SUN / 2 - 12 * (1 + SGN(T.NOON + T.SUN / 2 - 24)) * SGN(ABS(T.NOON + T.SUN / 2 - 24))
  87. 15050 COS.ZEN = ABS(COS(C.LAT + TILT.ANGLE))
  88. 15060 T.RELAX = 9.7 * COS.ZEN ^ 9.600001
  89. 15070 IF T.RELAX < .1 THEN T.RELAX = .1
  90. 15080 M.FACT! = 2.5 * GRNG * HOP.INV
  91. 15090 IF M.FACT! > PI.D2 THEN M.FACT! = PI.D2
  92. 15100 M.FACT! = SIN(M.FACT!)
  93. 15110 M.FACT! = 1 + 2.5 * M.FACT! * SQR(M.FACT!)
  94. 15120 IF T.SET < T.RISE THEN GOTO CHECK.TIME
  95. 15130 IF (GMT - T.RISE) * (T.SET - GMT) > 0 THEN GOTO DAY.TIME
  96. 16000 NITE.TIME:
  97. 16010 GMT0 = GMT + 12 * (1 + SGN(T.SET - GMT)) * SGN(ABS(T.SET - GMT))
  98. 16020 U0 = PI * T.RELAX / T.SUN
  99. 16030 U = (T.SET - GMT0) / 2
  100. 16040 U1 = -T.SUN / T.RELAX
  101. 16050 FRAC.SUN = PI * (GMT0 - T.SET) / (24 - T.SUN)
  102. 16060 COSX = COS.ZEN * (U0 * (EXP(U1) + 1)) * EXP(U) / (1 + U0 * U0): COSX1 = COSX
  103. 16070 FRAC.SUN = 0
  104. 16080 GOTO MUF.CALC
  105. 17000 CHECK.TIME:
  106. 17010 IF (GMT - T.SET) * (T.RISE - GMT) > 0 THEN GOTO NITE.TIME
  107. 18000 DAY.TIME:
  108. 18010 GMT0 = GMT + 12 * (1 + SGN(T.RISE - GMT)) * SGN(ABS(T.RISE - GMT))
  109. 18020 TAU0 = PI * (GMT0 - T.RISE) / T.SUN
  110. 18030 U0 = PI * T.RELAX / T.SUN
  111. 18040 U = (T.RISE - GMT0) / T.RELAX
  112. 18050 FRAC.SUN = PI * (GMT0 - T.RISE) / T.SUN
  113. 18060 COSX = COS.ZEN * (SIN(TAU0) + U0 * (EXP(U) - COS(TAU0))) / (1 + U0 * U0): COSX2 = COSX
  114. 18070 ALT.COSX = COS.ZEN * (U0 * (EXP(-T.SUN / T.RELAX) + 1)) * EXP((T.SUN - 24) / 2) / (1 + U0 * U0): COSX3 = ALT.COSX
  115. 18080 IF COSX >= ALT.COSX THEN GOTO MUF.CALC
  116. 18090 COSX = ALT.COSX
  117. 20000 MUF.CALC:
  118. 20010 MUF! = (1 + SSN / 250) * SQR(6 + 58 * SQR(COSX))
  119. 20020 F.VERT1 = MUF!
  120. 20030 MUF! = MUF! * (1 - .1 * EXP((T.SUN - 24) / 3))
  121. 20040 MUF! = MUF! * (1 + (1 - SGN(T.LAT) * SGN(R.LAT)) * .1)
  122. 20050 MUF! = MUF! * (1 - .1 * (1 + SGN(ABS(SIN(C.LAT)) - COS(C.LAT))))
  123. 20060 F.VERT = MUF!: MUF! = M.FACT! * MUF!:
  124. 20070 X.MONTH=MONTH
  125. 20080 IF ABS(METHOD)=1 THEN
  126. 20090  CALL CRIT.FREQ(C.LAT*CNV,C.LON*CNV,X.MONTH,GMT,SSN,ELEV,Z.MAG,HT.F2,F.VERT,MUF!)
  127. 20100 END IF
  128. 20110 M.FACT!=MUF!/F.VERT
  129. 21000 IF CTRL.POINTS% THEN IF MUF! < F.MUF THEN F.MUF = MUF!
  130. 21010 GOSUB ECUTOFF: GOSUB D.LOSS: GOSUB SIGNAL.STRENGTH:
  131. 21020 IF DIAGNOSTICS% THEN GOSUB PRINT.STUFF
  132. 21030 NEXT KHOP
  133. 21040 RETURN
  134. 24000 ECUTOFF: 'CALCULATE E LAYER CUTOFF FREQ
  135. 24010 E.FACT = .2: IF T.SUN = 0 THEN GOTO ESCREEN
  136. 24020 IF T.SUN * FRAC.SUN = 0 THEN GOTO ESCREEN
  137. 24030 E.COSX = COS.ZEN * SIN(PI * (GMT0 - T.RISE) / T.SUN)
  138. 24040 IF E.COSX > .174 THEN E.FACT = E.COSX ^ .3 ELSE E.FACT = (FNACOS(E.COSX) * CNV - 76) ^ -.4
  139. 24050 ESCREEN:
  140. 24060 E.SCREEN = (3.4 + .00544 * SSN) * E.FACT * SEC.EINC
  141. 24070 IF E.SCREEN > 7 THEN E.LUF = (1.33 * E.SCREEN - 3.31) ^ 2 / 7 ELSE E.LUF = .91 * E.SCREEN - .37
  142. 24080 IF CTRL.POINTS% THEN IF F.LUF < E.LUF THEN F.LUF = E.LUF
  143. 24090 IF CTRL.POINTS% THEN IF E.CUTOFF < E.SCREEN THEN E.CUTOFF = E.SCREEN
  144. 24100 RETURN
  145. 25000 D.LOSS: ' CALCULATE D REGION ABSORPTION
  146. 25010 IF METHOD<>1 THEN
  147. 25020    MAG.LAT! = FNASIN(COS(POL.LAT) * COS(C.LAT) * COS(POL.LON - C.LON) + SIN(POL.LAT) * SIN(C.LAT))
  148. 25030 ELSEIF METHOD=1 THEN
  149. 25040    MAG.LAT!=Z.MAG/CNV
  150. 25050 END IF
  151. 25060 F.GYRO = .8 * SQR(1 + 3 * SIN(MAG.LAT!) ^ 2)
  152. 25070 CHI = CNV * FNACOS(COS.ZEN * SIN(PI * (GMT0 - T.RISE) / T.SUN))
  153. 25080 IF CHI < 102 THEN XLOSS = 1.5 * 430 * (1 + .0035 * SSN) * COS(.881 * CHI / CNV) ^ .75 / (COS(PHID / CNV)) ELSE XLOSS = 0
  154. 25090 IF CHI < 102 THEN XINDEX = (1 + .0037 * SSN) * COS(.881 * CHI / CNV) ^ 1.3 ELSE XINDEX = 0
  155. 25100 IF XINDEX < .1 THEN XINDEX = .1
  156. 25110 XLOSS = 677.2 * XINDEX / (COS(PHID / CNV))
  157. 25120 FOR I = 1 TO NFREQ: ABSORB.LOSS(I) = ABSORB.LOSS(I) + XLOSS / ((FREQ(I) + F.GYRO) ^ 2 + 10.2): NEXT I
  158. 25130 RETURN
  159. 25140 SIGNAL.STRENGTH: 'CALCULATE SIGNAL STRENGTH
  160. 25150 FOR I = 1 TO NFREQ
  161. 25160 PR(I) = FNDB(PT) + GT(I) + TX.LOSS(I) + GR(I) + RX.LOSS(I) + REF.LOSS(I) - ABSORB.LOSS(I) + 2 * FNDB(WAVE.LEN(I)) - PATH.LOSS
  162. 25170 PR(I) = PR(I) - FNDB(.0000005 ^ 2 / 50)
  163. 25180 NEXT I: RETURN
  164. 29000 PRINT.STUFF:
  165. 29010 LPRINT USING "KHOP = ### GMT= ###  Fv=#####.# Fv1=#####.# Mf= ##.### MUF= #####.# "; KHOP; GMT; F.VERT; F.VERT1; M.FACT!; MUF!
  166. 29020 LPRINT USING "           HT.F2=       #####.#     #####.#          Z.MAG= #####.# "; HEIGHT.F2,HT.F2,Z.MAG
  167. 29030 LPRINT USING "           E.SCREEN=#####.# E.LUF=#####.# E.CUTOFF=#####.# F.LUF= #####.# "; E.SCREEN; E.LUF; E.CUTOFF; F.LUF
  168. 29040 LPRINT USING "     C.LAT=####.#  C.LON=####.# YR.ANGLE=####.# TILT.ANGLE=####.# COS.ZEN=##.###"; C.LAT * CNV; C.LON * CNV; YR.ANGLE * CNV; TILT.ANGLE * CNV; COS.ZEN
  169. 29050 LPRINT USING "     R.LAT=####.#  R.LON=####.# ELEV=####.# PHID=####.# R.SLANT=##### PATH.LOSS=####.#"; RF.LAT; RFL; ELEV; PHID; R.SLANT; PATH.LOSS
  170. 29060 FOR I = 1 TO NFREQ
  171. 29070 LPRINT USING "     F= ###.# TX.LOSS=###.# RX.LOSS=###.# REF.LOSS=###.# ABSORB=###.# PR= ###.#  ###"; FREQ(I); TX.LOSS(I); RX.LOSS(I); REF.LOSS(I); ABSORB.LOSS(I); PR(I); SEA%
  172. 29080 NEXT I
  173. 29090 LPRINT "": RETURN
  174. 29100 LPRINT USING "     T.NOON=###.# T.SUN=###.# T.RISE=###.# T.SET=###.# T.RELAX=###.# "; T.NOON; T.SUN; T.RISE; T.SET; T.RELAX
  175. 29110 LPRINT USING "     COSX=###.##     COSX1=###.## COSX2=###.## COSX3=###.##"; COSX; COSX1; COSX2; COSX3
  176. 29120 LPRINT USING "     TLAT=###.# TLON=###.# RLAT=###.# RLON=###.# GRNG=##### SSN=#### "; TLAT; TLON; RLAT; RLON; RE * GRNG; SSN
  177. 29130 LPRINT "": RETURN
  178. 29140 REM   CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
  179. 29150 SSN = -103.7767 + 1.797429 * SF - (3.384356E-03) * SF ^ 2 + (4.525515E-06) * SF ^ 3
  180. 29160 SSN = INT(100 * SSN + .5) / 100
  181. 29170 RETURN
  182. 29180 END SUB
  183. 30000 SUB CRIT.FREQ(XN,YN,X.MONTH,T.UTC,R,AE,Z.MAG,HF,F0F2,F.MUF) STATIC
  184. 30010 '
  185. 30020  REM THIS IS THE F-LAYER ALGORITHM FOR MAXIMUF3 AND IT HAS THE NEW
  186. 30030  REM POLAR ALGORITHM IN IT.  THUS, IT WOULD BE SUITABLE TO USE IN
  187. 30040  REM THE MAPPER SUB-ROUTINE FOR CRITICAL FREQUENCIES.
  188. 30050  REM
  189. 30060  REM THE INPUT DATA THAT ARE REQUIRED INCLUDE THE LATITUDE (XN) AND
  190. 30070  REM WEST LONGITUDE (YN) OF THE POINT UNDER CONSIDERATION.  ALSO,
  191. 30080  REM IT WILL NEED THE MONTH (X.MONTH), TIME OF DAY (T.UTC) IN HOURS UTC,
  192. 30090  REM THE SUNSPOT NUMBER (R) AND THE RADIATION ANGLE (AE) IN DEGREES
  193. 30100  REM ABOVE THE HORIZON.
  194. 30110  REM
  195. 30120  REM FINALLY, THE VARIABLES IN THE ALGORITHM MUST BE DIMENSIONED IN THE
  196. 30130  REM MAIN PROGRAM OR IN THE SUB-ROUTINE WHEN IT IS CALLED.  A GUIDE TO
  197. 30140  REM THESE REQUIREMENTS IS TO BE FOUND IN THE BEGINNING OF THE
  198. 30150  REM MAXIMUF3.BAS PROGRAM ITSELF.
  199. 30160  REM
  200. 30170  REM * * * * * * * * * * MAXIMUF3 F-LAYER ALGORITHM * * * * * * * * * * *
  201. 30180  REM
  202. 30190  REM THIS VERSION OF MAXIMUF3 HAS THE NEW POLAR ALGORITHM IN IT!
  203. 30200  REM
  204. 30210  DIM FF(25)
  205. 30220  REM
  206. 30230  REM F-2 LAYER CALCULATION
  207. 30240  '
  208. 30250  CALL MAG.LATITUDE(XN,YN,Z.MAG)
  209. 30260 '
  210. 30270  T.LOCAL=T.UTC-YN/15
  211. 30280  'LOCAL TIME AT XN, YN
  212. 30290 '
  213. 30300  IF T.LOCAL>24 THEN T.LOCAL=T.LOCAL-24
  214. 30310  IF T.LOCAL<0 THEN T.LOCAL=T.LOCAL+24
  215. 30320 '
  216. 30330  AX=1-.034*COS(30*(X.MONTH-6.25)*RPD):
  217. 30340  'ANNUAL VARIATION
  218. 30350 '
  219. 30360 'MAKE SOUTHERN HEMISPHERE SAME AS NORTHERN 6 MONTHS LATER
  220. 30370  Z.MONTH=X.MONTH
  221. 30380  IF Z.MAG<0 THEN
  222. 30390     Z.MAG=-Z.MAG
  223. 30400     Z.MONTH=X.MONTH+6
  224. 30410  END IF
  225. 30420 '
  226. 30430  XH=COS(30*(Z.MONTH-6.5)*RPD)
  227. 30440  ' 1 WEEK DELAY ON EQUINOXES
  228. 30450  SX=(ABS(XH)+XH)/2
  229. 30460  ' F-LAYER LOCAL SUMMER VARIATION
  230. 30470  WX=(ABS(XH)-XH)/2
  231. 30480  ' F-LAYER LOCAL WINTER VARIATION
  232. 30490 '
  233. 30500 IF Z.MAG>77.5 THEN
  234. 30510    ' POLAR ALGORITHM
  235. 30520    SSN=R
  236. 30530    ' CHANGE R TO SSN FOR POLAR ALGORITHM
  237. 30540    FF.POL1=(3+SX*1.1-WX*.3)*(1+SSN/(150+SX*230-WX*5))
  238. 30550    FF.POL2=(3.1*(1-SX)+WX*1.7)*(1-SSN/(210+WX*40))/(95-ABS(XN))-SX*SSN/100/(95-ABS(XN))
  239. 30560    FF.POL3=(.04-SX*.02+WX*.01)*(1+SSN/(315+SX*1185-WX*100))*(90-ABS(XN))*SIN(15*(T.LOCAL-7.5+SX*.5-WX*.5-SSN*(1-WX)/(100+SX*50))*RPD)
  240. 30570    FF.POL4=(SX*.005+WX*.02*(1+SSN/150))*(90-ABS(XN))*SIN(30*(T.LOCAL-8-WX*2+SSN/150)*RPD)
  241. 30580    F0F2=AX*(FF.POL1+FF.POL2+FF.POL3+FF.POL4)
  242. 30590    ' foF2 IN POLAR REGIONS
  243. 30600 ELSE
  244. 30610    TY=T.LOCAL
  245. 30620    IF TY<5 THEN TY=T.LOCAL+24
  246. 30630    TN=T.LOCAL
  247. 30640    IF TN<15+SX-WX*3 THEN TN=T.LOCAL+24
  248. 30650 '
  249. 30660    Q=(TY-14-SX*2+WX*2-R/(200-SX*50-WX*50))
  250. 30670    'Q IS C FACTOR
  251. 30680    YF1=Q*(7-SX*3+WX*4-R/(150-WX*75))
  252. 30690    IF ABS(YF1)>60 THEN YF1=60
  253. 30700    'YF1 IS B*(T-C) IN FRICKER
  254. 30710 '
  255. 30720    X=(6.5-WX*.5)*(1+R/(170+SX*200+WX*15))
  256. 30730    'X IS A FACTOR
  257. 30740 '
  258. 30750    FF(1)=X*COS(YF1*RPD)*COS((Z.MAG-SX*5+WX*5)*RPD)^.5
  259. 30760    ' FF(1) IS THE MAIN FRICKER TERM
  260. 30770 '
  261. 30780    YA=(TY-8.5-R*SX/125)*(30-R*SX/30)
  262. 30790    IF ABS(YA)>89 THEN YA=89
  263. 30800    X=(2.3-SX*1.1+WX*.2)
  264. 30810    Q=(1+R/(400-SX*320-WX*225))
  265. 30820    FA=X*Q*COS(YA*RPD)*COS((Z.MAG-4+SX*4-WX-R*WX/30)*RPD)^24
  266. 30830 '
  267. 30840    X=(TY-14.5+SX*1.3+WX*.2+R/(75+SX*25+WX*100))
  268. 30850    YB=X*(18+SX*8-WX-R*(1-WX*4)/(150-SX*138))
  269. 30860    IF ABS(YB)>89 THEN YB=89
  270. 30870    X=(4.6-SX*2.6-WX*1.3)*(1-R*(1-SX-WX*7/5)/600)
  271. 30880    FB=X*COS(YB*RPD)*COS((Z.MAG-15+WX*3-R*(SX/12+WX/150))*RPD)^48
  272. 30890 '
  273. 30900    X=(TY-19+SX*2.2+WX*.2-R*(1-SX*5/3)/(100+WX*10))
  274. 30910    YC=X*(18+SX*8-WX-R/(50-SX*35+WX*100))
  275. 30920    IF ABS(YC)>89 THEN YC=89
  276. 30930    X=(3.3-SX*.2+WX*.8)*(1+R/(290-SX*15-WX*130))
  277. 30940    Q=X*COS(YC*RPD)
  278. 30950    FC=Q*COS((Z.MAG-3-SX*10-R*(1-SX*6/5)/(15+WX*5))*RPD)^48
  279. 30960 '
  280. 30970    X=(TY-24+SX*.3-WX*.2-R*(1-SX*2)/(200-WX*100))
  281. 30980    YD=X*(26+WX*10-R/(75-SX*35-WX*57))
  282. 30990    IF ABS(YD)>89 THEN YD=89
  283. 31000    X=(2.6-SX*4.7-WX*1.6)*(1+R*(1-SX*17/5)/(180-WX*130))
  284. 31010    Q=X*COS(YD*RPD)
  285. 31020    FD=Q*COS((Z.MAG-3-SX*4-WX-R/(75-SX*50-WX*15))*RPD)^64
  286. 31030 '
  287. 31040    Q=(1-SX*7/3-WX*2)
  288. 31050    YF3=(TN-28.9+SX*.2+WX*.2-R*Q/600)*(36+WX*9+R*SX/25)
  289. 31060    IF ABS(YF3)>89 THEN YF3=89
  290. 31070    X=-(1.3+SX*1.1+WX*.2)*(1-R/(170+SX*130+WX*1490))
  291. 31080    Q=X*COS(YF3*RPD)
  292. 31090    FF(3)=Q*COS((Z.MAG-8+SX*6-WX*2-R*(1-SX*2)/(75-WX*65))*RPD)^16
  293. 31100 '
  294. 31110    X=(TN-26.5-SX*1.5+WX*3.5-R*WX/75)
  295. 31120    YF4=X*(7-SX*.5-WX*2+R*(1-SX)/(50+WX*10))
  296. 31130    IF ABS(YF4)>89 THEN YF4=89
  297. 31140    X=(1.3+SX*.1-WX*.1)*(1+R*(1-SX*4/3)/(170-WX*85))
  298. 31150    FF(4)=X*COS(YF4*RPD)*SIN((Z.MAG+13+SX*2-WX*2)*RPD)^64
  299. 31160 '
  300. 31170    YF5=(TY-12)*13
  301. 31180    IF ABS(YF5)>89 THEN YF5=89
  302. 31190    Q=.8*(1-SX-WX)*(1+R/70)
  303. 31200    FF(5)=Q*COS(YF5*RPD)*COS((Z.MAG-25-R/15)*RPD)^24
  304. 31210 '
  305. 31220    YF6=(TN-23-R/100)*(20+R/75)
  306. 31230    IF ABS(YF6)>89 THEN YF6=89
  307. 31240    FF(6)=R*(1-SX-WX)/60*COS(YF6*RPD)*COS((Z.MAG-18)*RPD)^48
  308. 31250 '
  309. 31260    YF7=(TN-26)*36
  310. 31270    IF ABS(YF7)>89 THEN YF7=89
  311. 31280    FF(7)=-SX*1.3*(1-R/150)*COS(YF7*RPD)*COS(Z.MAG*RPD)^64
  312. 31290 '
  313. 31300    YF8=(TY-13+R/300)*(15+R/75)
  314. 31310    IF ABS(YF8)>89 THEN YF8=89
  315. 31320    FF(8)=R*WX/33*COS(YF8*RPD)*COS((Z.MAG-52)*RPD)^16
  316. 31330 '
  317. 31340    Q=FF(1)+FA+FB+FC+FD+FF(3)
  318. 31350    F01=Q+FF(4)+FF(5)+FF(6)+FF(7)+FF(8)
  319. 31360 '
  320. 31370    Q=(TY-10.5+WX*1.5+R*(1-WX*2)/300)
  321. 31380    YF9=Q*(60-WX*24-R/(10+WX*20))
  322. 31390    IF ABS(YF9)>89 THEN YF9=89
  323. 31400    X=(-R*(1-SX)/150+WX*.8*(1+R/175))
  324. 31410    Q=X*COS(YF9*RPD)
  325. 31420    FF(9)=Q*COS((Z.MAG-20-WX*2+R*(1-WX*33/13)/20)*RPD)^48
  326. 31430 '
  327. 31440    YF10=(TY-15)*(18-R/75)
  328. 31450    IF ABS(YF10)>89 THEN YF10=89
  329. 31460    Q=-SX*.8*(1-R/600)
  330. 31470    FF(10)=Q*COS(YF10*RPD)*COS((Z.MAG-47-R/40)*RPD)^48
  331. 31480 '
  332. 31490    YF11=(TY-18.5-WX*.5-R*WX/150)*(30+WX*15)
  333. 31500    IF ABS(YF11)>89 THEN YF11=89
  334. 31510    X=(SX*.5*(1+R/300)+WX*R/250)
  335. 31520    Q=X*COS(YF11*RPD)
  336. 31530    FF(11)=Q*COS((Z.MAG-27+WX*7+R*(1-WX*11/6)/25)*RPD)^48
  337. 31540 '
  338. 31550    YF12=(TY-20+WX-R*(1-WX*2)/100)*(45-R*(1-WX)/15)
  339. 31560    IF ABS(YF12)>89 THEN YF12=89
  340. 31570    Q=-R*(1-SX-WX*2)
  341. 31580    FF(12)=Q/160*COS(YF12*RPD)*COS((Z.MAG-45+WX*3)*RPD)^48
  342. 31590 '
  343. 31600    YF13=(TY-20.5)*22
  344. 31610    IF ABS(YF13)>89 THEN YF13=89
  345. 31620    Q=-R*(1-SX-WX)
  346. 31630    FF(13)=Q/150*COS(YF13*RPD)*COS((Z.MAG-6+R/17)*RPD)^64
  347. 31640 '
  348. 31650    YF14=(TY-22-WX+R/150)*(45-WX*27+R*WX/10)
  349. 31660    IF ABS(YF14)>89 THEN YF14=89
  350. 31670    X=-.4*(1-SX+WX/4)*(1-R/(48-WX*18))
  351. 31680    Q=X*COS(YF14*RPD)
  352. 31690    FF(14)=Q*COS((Z.MAG-15-WX*5+R/(25-WX*10))*RPD)^64
  353. 31700 '
  354. 31710    YF15=(TY-22-WX*2-R*(1-WX)/75)*(20+R*(1-WX)/30)
  355. 31720    IF ABS(YF15)>89 THEN YF15=89
  356. 31730    Q=(-SX*.6+WX*R/100)
  357. 31740    FF(15)=Q*COS(YF15*RPD)*COS((Z.MAG-70+WX*5)*RPD)^64
  358. 31750 '
  359. 31760    Q=(TN-24-SX*1.5-R*(1-SX*2)/75)
  360. 31770    YF16=Q*(30-SX*8-R*(1+SX*7/5)/30)
  361. 31780    IF ABS(YF16)>89 THEN YF16=89
  362. 31790 '
  363. 31800    X=.3*(1-SX*13/3-WX)*(1+R*(1-SX*8/5)/150)
  364. 31810    FF(16)=X*COS(YF16*RPD)*COS((Z.MAG-32-SX*6-R*SX/15)*RPD)^48
  365. 31820 '
  366. 31830    YF17=(TN-26.5+R/150)*(22+R/15)
  367. 31840    IF ABS(YF17)>89 THEN YF17=89
  368. 31850    Q=-.5*(1-SX-WX)*(1-R/65)
  369. 31860    FF(17)=Q*COS(YF17*RPD)*COS((Z.MAG-55-R/75)*RPD)^48
  370. 31870 '
  371. 31880    Q=FF(9)+FF(10)+FF(11)+FF(12)
  372. 31890    F02=Q+FF(13)+FF(14)+FF(15)+FF(16)+FF(17)
  373. 31900 '
  374. 31910  IF WX<>0 THEN
  375. 31920    YF18=(TY-8.5)*45
  376. 31930    IF ABS(YF18)>89 THEN YF18=89
  377. 31940    Q=-.4*(1+R/250)
  378. 31950    FF(18)=Q*COS(YF18*RPD)*COS((Z.MAG-60+R/30)*RPD)^64
  379. 31960 '
  380. 31970    YF19=(TY-9.5)*(20+R/15)
  381. 31980    IF ABS(YF19)>89 THEN YF19=89
  382. 31990    FF(19)=-.5*(1+R/150)*COS(YF19*RPD)*COS((Z.MAG-68)*RPD)^64
  383. 32000 '
  384. 32010    YF20=(TY-15-R/35)*(22-R/50)
  385. 32020    IF ABS(YF20)>89 THEN YF20=89
  386. 32030    Q=.6*(1+R/175)*COS(YF20*RPD)
  387. 32040    FF(20)=Q*COS((Z.MAG-27-R/50)*RPD)^64
  388. 32050 '
  389. 32060    YF21=(TY-17.5-R/100)*45
  390. 32070    IF ABS(YF21)>89 THEN YF21=89
  391. 32080    FF(21)=.2*(1+R/75)*COS(YF21*RPD)*COS((Z.MAG-70)*RPD)^64
  392. 32090 '
  393. 32100    YF22=(TY-19-R/75)*(20+R/75)
  394. 32110    IF ABS(YF22)>89 THEN YF22=89
  395. 32120    Q=-.7*(1+R/450)
  396. 32130    FF(22)=Q*COS(YF22*RPD)*COS((Z.MAG-52+R/15)*RPD)^24
  397. 32140 '
  398. 32150    YF23=(TN-29)*45
  399. 32160    IF ABS(YF23)>89 THEN YF23=89
  400. 32170    Q=-.6*(1+R/300)
  401. 32180    FF(23)=Q*COS(YF23*RPD)*COS((Z.MAG-57+R/15)*RPD)^48
  402. 32190 '
  403. 32200    F03=FF(18)+FF(19)+FF(20)+FF(21)+FF(22)+FF(23)
  404. 32210 '
  405. 32220  END IF
  406. 32230 '
  407. 32240  F0F2=AX*(F01+F02+WX*F03)
  408. 32250  'foF2 FOR VERTICAL INCIDENCE
  409. 32260 END IF
  410. 32270 '
  411. 32280  HT=275+R/2
  412. 32290  HF=HT
  413. 32300  IF Z.MAG<=5 THEN
  414. 32310     HF=HT+50
  415. 32320     IF T.LOCAL>2 AND T.LOCAL<9 THEN HF=HT+25
  416. 32330     IF T.LOCAL>4 AND T.LOCAL<7 THEN HF=HT
  417. 32340  ELSEIF Z.MAG<=10 THEN
  418. 32350     HF=HT+25+25*SX
  419. 32360     IF T.LOCAL>2 AND T.LOCAL<9 THEN HF=HT+25*SX
  420. 32370     IF T.LOCAL>4 AND T.LOCAL<7 THEN HF=HT
  421. 32380  ELSEIF Z.MAG>=20 AND Z.MAG<=60 THEN
  422. 32390     IF T.LOCAL>8 AND T.LOCAL<16 THEN HF=HT+SX*50-WX*25
  423. 32400     IF T.LOCAL>23 OR T.LOCAL<3 THEN HF=HT+WX*50
  424. 32410  END IF
  425. 32420 '
  426. 32430  SF=(1-(COS(AE*RPD)*RE/(RE+HF))^2)^(-.5)
  427. 32440  ' SECANT FACTOR
  428. 32450  F.MUF=(F0F2*SF)
  429. 32460  ' CRITICAL FREQUENCY FOR OBLIQUE INCIDENCE
  430. 32470 '
  431. 32480 END SUB
  432. 40000 SUB MAG.LATITUDE(XN,YN,Z.MAG) STATIC
  433. 40010   'COMPUTATION OF MAGNETIC LATITUDE
  434. 40020   YZ=YN
  435. 40030   IF YN<-160 THEN YZ=360+YN
  436. 40040   YG=(20-YZ)/50
  437. 40050   Z0=20*YG/(1+YG+YG^2)+5*(1-YG/7)^2
  438. 40060   Z.MAG=XN-Z0
  439. 40070 END SUB
  440. 41000 SUB REFLECT (ELEV, WAVE.LEN, SEA%, RMAGV, VPHASE, RMAGH, HPHASE, REFLECT.LOSS) STATIC
  441. 41010 'REFLECTION COEFFICIENT CALCULATION
  442. 41020 IF SEA% THEN ER = 80: EI = -60 * WAVE.LEN * 4: DH = 4 ELSE ER = 15: EI = -60 * WAVE.LEN * .01: DH = 10
  443. 41030 RHO = EXP(-2 * (2 * PI * DH * SIN(ELEV / CNV) / WAVE.LEN) ^ 2)
  444. 41040 CA = COS(ELEV / CNV) ^ 2: SA = SIN(ELEV / CNV): SQ1 = ER - CA: PQ1 = .5 * ATN(EI / SQ1): SMAG = SQR(SQ1 ^ 2 + EI ^ 2)
  445. 41050 SMAG = SQR(SMAG): SQ1 = SMAG * COS(PQ1): SQ2 = SMAG * SIN(PQ1):
  446. 41060 DENH = (SQR((SA + SQ1) ^ 2 + SQ2 ^ 2)): PHASE1 = SQ2: PHASE2 = SA + SQ1: GOSUB 41140: HPHASE = PHASE
  447. 41070 NUMH! = (SQR((SA - SQ1) ^ 2 + SQ2 ^ 2)): PHASE1 = -SQ2: PHASE2 = SA - SQ1: GOSUB 41140: HPHASE1 = PHASE
  448. 41080 RMAGH = NUMH! / DENH: HPHASE = HPHASE1 - HPHASE
  449. 41090 DENV = SQR((SA * ER + SQ1) ^ 2 + (EI * SA + SQ2) ^ 2): PHASE1 = (EI * SA + SQ2): PHASE2 = (ER * SA + SQ1): GOSUB 41140: VPHASE = PHASE
  450. 41100 NUMV! = SQR((SA * ER - SQ1) ^ 2 + (EI * SA - SQ2) ^ 2): PHASE1 = (EI * SA - SQ2): PHASE2 = (ER * SA - SQ1): GOSUB 41140: VPHASE1 = PHASE
  451. 41110 RMAGV = NUMV! / DENV: VPHASE = VPHASE1 - VPHASE
  452. 41120 REFLECT.LOSS = FNDB(.5 * (RMAGH ^ 2 + RMAGV ^ 2) * RHO ^ 2)
  453. 41130 EXIT SUB
  454. 41140 '4 QUADRANT ARC TANGENT
  455. 41150 IF PHASE2 > 0 THEN PHASE = ATN(PHASE1 / PHASE2): RETURN
  456. 41160 IF PHASE1 < 0 THEN PHASE = -PI + ATN(PHASE1 / PHASE2) ELSE PHASE = PI + ATN(PHASE1 / PHASE2)
  457. 41170 RETURN
  458. 41180 END SUB
  459. 42000 SUB MULTIPATH (ELEV, WAVE.LEN, H.ANTENNA, XMULTV, XMULTH) STATIC
  460. 42010 ' MULTIPATH CALCULATION
  461. 42020 CALL REFLECT(ELEV, WAVE.LEN, 0, RMAGV, VPHASE, RMAGH, HPHASE, REFLECT.LOSS)
  462. 42030 ALPHAV = VPHASE - 4 * PI * H.ANTENNA * SIN(ELEV / CNV) / WAVE.LEN: XMULTV = FNDB((1 + RMAGV * COS(ALPHAV)) ^ 2 + (RMAGV * SIN(ALPHAV)) ^ 2)
  463. 42040 ALPHAH = HPHASE - 4 * PI * H.ANTENNA * SIN(ELEV / CNV) / WAVE.LEN: XMULTH = FNDB((1 + RMAGH * COS(ALPHAH)) ^ 2 + (RMAGH * SIN(ALPHAH)) ^ 2)
  464. 42050 XMULT = FNDB(.5 * (FNDBI(XMULTV) + FNDBI(XMULTH)))
  465. 42060 END SUB
  466. 44000 SUB FIND.OCEAN(XLON,XLAT,SEA%) STATIC
  467. 44010 DATA 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384
  468. 44020 IF NOT FIRST% THEN
  469. 44030    FIRST%=-1
  470. 44040    REDIM SEA.MAP(25,180) AS INTEGER,MASK(14) AS INTEGER
  471. 44050    RESTORE 44010
  472. 44060    FOR I=0 TO 14:READ MASK(I):NEXT
  473. 44070    NSEG=VARSEG(SEA.MAP(0,0)):NOFF=VARPTR(SEA.MAP(0,0))
  474. 44080    DEF SEG=NSEG:BLOAD "SEA-MAP.DAT",NOFF:DEF SEG
  475. 44090 END IF
  476. 44100 NX=(XLON):NY=90+XLAT
  477. 44110 IF NX<0 THEN NX=360+NX ELSE IF NX>360 THEN NX=NX-360
  478. 44120 IF NY<0 THEN NY=0 ELSE IF NY>180 THEN NY=180
  479. 44130 MX=NX\15:LX=NX-15*MX
  480. 44140 SEA%=SEA.MAP(MX,NY) AND MASK(LX)
  481. 44150 IF SEA% THEN SEA%=-1
  482. 44160 END SUB
  483. 46000 SUB CREATE.OCEAN
  484. 46010 DATA 1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384
  485. 46020 REDIM SEA.MAP(25,180) AS INTEGER,MASK(14) AS INTEGER
  486. 46030 RESTORE 46010
  487. 46040 FOR I=0 TO 14:READ MASK(I):NEXT
  488. 46050 FOR XLAT=-90 TO 90.001
  489. 46060 FOR KLON=180 TO -180 STEP -1
  490. 46070 XLON=KLON
  491. 46080 NX=(180-XLON):NY=90+XLAT
  492. 46090 IF NX<0 THEN NX=0 ELSE IF NX>360 THEN NX=360
  493. 46100 IF NY<0 THEN NY=0 ELSE IF NY>180 THEN NY=180
  494. 46110 MX=NX\15:LX=NX-15*MX
  495. 46120 MAP.COLOR=POINT(XLON, XLAT)
  496. 46130 SEA%=0
  497. 46140 IF MAP.COLOR = 1 THEN
  498. 46150    SEA%=-1
  499. 46160    SEA.MAP(MX,NY)=SEA.MAP(MX,NY) OR MASK(LX)
  500. 46170 END IF
  501. 46180 NEXT KLON,XLAT
  502. 46190 NSEG=VARSEG(SEA.MAP(0,0)):NOFF=VARPTR(SEA.MAP(0,0))
  503. 46200 DEF SEG=NSEG:BSAVE "SEA-MAP.DAT",NOFF,2*26*181:DEF SEG
  504. 46210 ERASE SEA.MAP
  505. 46220 END SUB
  506.